Celestin Apprentice 5/Apprentice-Release5.iso/Source Code/Think Class Libraries/CPixMap.p 1.0/CPixMap.p

Text File | 1996-02-04 | 26.8 KB | 848 lines | [TEXT/PJMM]

{****************************************************}
{}
{        CPixMap.p                                                                                                                                                                                                                }
{}
{        SUPERCLASS = CBitMap                                                                                                                                                                    }
{}
{        Copyright © 1996 Patrick C Hew. All rights reserved.                                                                        }
{}
{        Based on CColorBitMap.c Code by John A Love, III                                                                                        }
{        email : [e-mail]                                                                                                                                                                            }
{}
{        Translated from CPixMap.cp Code by Marty R Wachter                                                                        }
{        email : [e-mail]     or [e-mail]                                                                                }
{}
{        The principal focus of the other files is to OVERRIDE the THINK Class Library's    }
{        "CBitMap" and "CBitMapPane" classes to accomodate color.                                                            }
{}
{        The principal foundation of this work rests with Forrest Tanaka 's    Macintosh        }
{        Technical Note #120. Other, though lesser, key points are :                                                            }
{}
{        •    I have introduced a new instance variable of CBitMapPane in my                                        }
{                CColorBitMapPane class which I call "bitsUnderPane ". It becomes very                }
{                useful when dragging objects around , vice having to take a "picture" of                 }
{                the entire window or screen as Symantec 's    Art Class demo does.     I must        }
{                admit , however , that I have not YET    figured out how to update this                        }
{                "bitsUnderPane" CColorBitMap with a change in color depth, for example,        }
{                when using the popular "Switch-A-Roo"     FKEY. Please refer to my Update            }
{                method for further insight. By the way, Update works just fine    with                        }
{                "itsBitMap", the on-th -top CBitMap.                                                                                                                        }
{        •    I have made much more prolific comments throughout the source.                                    }
{                I truly hope that they are sufficient to guide you.                                                                                    }
{}
{        Original Author : John A . Love , III email : [e-mail]                                                                }
{}
{        Revision History:                                                                                                                                                                                        }
{}
{        Version:    1.0 for TCL 1.1.3 (C)                                                                                                                                                }
{        Date:             1993                                                                                                                                                                                                }
{        Author:        John A Love, III     <[e-mail]>                                                                                                            }
{        Notes:            Original release.                                                                                                                                                                }
{}
{        Version:    2.0 for TCL 2.0.3 (C++)                                                                                                                                        }
{        Date:             10 November 1994                                                                                                                                                        }
{        Author:        Marty R Wachter     <[e-mail]> or                                                }
{                                                                                            <[e-mail]>                                                                                            }
{        Notes:            Added support for real C++ in TCL 2.0 by adding proper,                                        }
{                                    constructors, destructors, class definitions, etc… to conform to                }
{                                    the TCL 2.0 changes.                                                                                                                                                    }
{}
{        Version:    1.0 for TCL 1.1.2 (Pascal)                                                                                                                                    }
{        Date:             28 January 1996                                                                                                                                                            }
{        Author:        Patrick C Hew     <[e-mail]>                                                                                }
{        Notes:            Translated from CPixMap.cp.                                                                                                                            }
{}
{****************************************************}


unit CPixMap;

interface

    uses
        TCL, MoreTCL;

    const
        kMaxRowBytes = $3FFE;    { Max # of bytes in a row of pixels. }
        kDefaultRes = $00480000;    { Default resolution is 72 DPI; Fixed type. }
        kITabRes = 4;    { Inverse-table resolution. }

    { For Error handling in my offscreen map routine(s) }
    const
        NewPortError = -10000;
        DepthError = -12000;
        MaxRowBytesError = -14000;
        NewBaseAddrPtrError = -16000;
        ColorTableError = -18000;
        CreateGDeviceError = -20000;
        NilGDeviceError = -22000;
        ZoomWindowError = -24000;

    type
        CPixMap = object(CBitmap)

                saveDevice: GDHandle;
                savePixMap: PixMapHandle;
                itsPixMap: PixMapHandle;
                macBits: Handle;
                itsColors: CTabHandle;
                itsMaxDevice: GDHandle;

                { Construct a PixMap object. }
                procedure IPixMap (width: Integer;
                                            height: Integer;
                                            makePort: Boolean);

                { Destroy a PixMap object, resetting all pointers. }
                procedure Free;
                override;

                { Determine whether the pixel at the specified coordinates is black. }
                { Returns FALSE if the pixel is white or the point is not within the PixMap. }
                { This method is overriden SOLELY because I need to avoid all reference to }
                { "macBitMap" in order to NOT have to HLock the "itsPixMap".     }
                function PixelIsBlack (pixelPos: LongPt): Boolean;
                override;

                { Set up for drawing to a BitMap. If it doesn't have its own port, }
                { make it the port bits of the current QuickDraw grafPort. Save the }
                { current port bits so they can be restored later by the EndDrawing }
                { method. If it has its own port, save the current port and SetPort }
                { to the BitMap's port. }
                procedure BeginDrawing;
                override;

                { Reset the port to the way it was before the BeginDrawing message }
                { was sent. If BitMap has its own port, restore the saved Grafport. }
                { Otherwise, restore the saved bitmap in the current port. }
                procedure EndDrawing;
                override;

                { Copy bits from a BitMap to the bit map of the current port. The }
                { fromRect is a rectangle in this BitMap (source rect), and the }
                { toRect is a rectangle in the current port's bit map (dest rect). }
                { maskRgn is a clipping region specified in the same coords as the }
                { dest rect, i.e., the coords of the current port. A nil maskRgn means }
                { that no extra clipping is performed. Copying takes place using the }
                { transfer mode stored in the xferMode instance variable. }
                procedure CopyFrom (fromRect, toRect: LongRect;
                                            maskRgn: RgnHandle);
                override;

                { Copy bits to a BitMap from the bit map of the current port. The }
                { fromRect is a rectangle in the current port's bit map (source rect), }
                { and the toRect is a rectangle in this BitMap (dest rect). maskRgn is }
                { a clipping region specified in the same coords as the dest rect, }
                { i.e., the coords of this BitMap. A nil maskRgn means that no extra }
                { clipping is performed. Copying takes place using the transfer mode }
                { stored in the xferMode instance variable. }
                procedure CBitMap.CopyTo (fromRect, toRect: LongRect;
                                            maskRgn: RgnHandle);
                override;

                { Return the bounding rectangle of a PixMap. This rectangle defines }
                { the size and coordinate system of the PixMap. }
                procedure GetBounds (var theBounds: LongRect);
                override;

                { Set the coordinates of the top left corner of the bounds of a }
                { PixMap. This changes the coordinate system of the PixMap. }
                procedure SetBoundsOrigin (hOrigin, vOrigin: integer);
                override;

                { Set the location-specific and size-specific information of the pixel map. }
                { This is a private method. }
                function SetupPixMap (aPixMap: PixMapHandle;
                                            imageBits: Handle;
                                            bytesPerRow: Integer;
                                            theBounds: Rect): CTabHandle;

                { Build and offscreen device for use with the offscreen pixmap. }
                { This is a private method. }
                function CreateGDevice (basePixMap: PixMapHandle): GDHandle;

            end; { CPixMap }


implementation

    uses
        LongQD;    { and GestaltEqu, which is included in THINK Pascal automatically. }


{****************************************************}
{}
{        IPixMap                                                                                                                                                                                                                    }
{}
{        Construct a PixMap object.                                                                                                                                                            }
{}
{****************************************************}

    procedure CPixMap.IPixMap (width: Integer;
                                    height: Integer;
                                    makePort: Boolean);

        var
            theBounds: Rect;
            qdVersion, tempSeed: LongInt;
            err: OSErr;
            depthIndexed, depthDirect, qd32BitInstalled, savedAlloc: Boolean;
            maxDepth, offRowBytes: Integer;
            sizeOfOff: LongInt;

    begin { IPixMap }
        xferMode := srcCopy;
        macPort := nil;
        macBitmap.baseAddr := nil;
        itsPixMap := nil;
        macBits := nil;
        itsColors := nil;
        itsMaxDevice := nil;

        { I will ignore "makePort" because my bitMap/pixMap }
        { is intricately tied to the off-screen Port. }

        SetRect(theBounds, 0, 0, width, height);
        GetPort(savePort);     { Also used by superclass's BeginDrawing and EndDrawing. }

        if not gSystem.hasColorQD then begin
            { A low life machine. }

            savedAlloc := SetAllocation(kAllocCanFail);
            macPort := GrafPtr(NewPtrClear(SizeOf(GrafPort)));
            savedAlloc := SetAllocation(savedAlloc);

            if macPort = nil then begin
                FailOSErr(NewPortError);
            end; { if }

            OpenPort(macPort);
            maxDepth := 1;
        end { if }
        else begin
            { Has Color Quickdraw. }

            savedAlloc := SetAllocation(kAllocCanFail);
            macPort := GrafPtr(NewPtrClear(SizeOf(CGrafPort)));
            savedAlloc := SetAllocation(savedAlloc);

            if macPort = nil then begin
                FailOSErr(NewPortError);
            end; { if }

            OpenCPort(CGrafPtr(macPort));
            itsPixMap := CGrafPtr(macPort)^.portPixMap;

            maxDepth := itsPixMap^^.pixelSize;

            if gSystem.hasGestalt then begin
                err := Gestalt(gestaltQuickdrawVersion, qdVersion);
                qd32BitInstalled := qdVersion >= gestalt32BitQD;
            end { if }
            else begin
                qd32BitInstalled := FALSE;
            end; { else }

            depthIndexed := maxDepth <= 8;
            depthDirect := (maxDepth > 8) & qd32BitInstalled;

            if not depthIndexed and not depthDirect then begin
                SetPort(savePort);
                FailOSErr(DepthError);
            end { if }
        end; { else }

        { Before we do ANYthing more, we should set the off-screen's }
        { visRgn to the FULL size of the input rect so the image stays }
        { whole even when the window has been dragged partly beyond}
        { the physical edge ( s ) of the screen. Otherwise, the }
        { (**visRgn).rgnBBox in local coordinates remains equal to }
        { screenBits . bounds as initialized when _Open ( C ) Port was called: }

        RectRgn(macPort^.visRgn, theBounds);
        macPort^.portRect := theBounds;
        ClipRect(theBounds);

        { We are now ready to calculate the size of the pixel image we will need. }
        { Then we can set the location-specific and size-specific information of }
        { the pixel map by calling SetupPixMap if we have color or stuffing }
        { directly if in black-and-white. }

        offRowBytes := (maxDepth * (theBounds.right - theBounds.left) + 15) div 16;

        { Make even. }
        if offRowBytes mod 2 <> 0 then begin
            offRowBytes := offRowBytes + 1;
        end; { if }

        { Back to bytes. }
        offRowBytes := offRowBytes * 2;

        if offRowBytes > kMaxRowBytes then begin
            SetPort(savePort);
            FailOSErr(MaxRowBytesError);
        end; { if }

        sizeOfOff := (theBounds.bottom - theBounds.top) * LongInt(offRowBytes);

        { Allocate space for the pixel image. }
        savedAlloc := SetAllocation(kAllocCanFail);
        ReserveMem(sizeOfOff); { Around forever. }
        macBits := NewHandleClear(sizeOfOff);
        savedAlloc := SetAllocation(savedAlloc);

        if macBits = nil then begin
            SetPort(savePort);
            FailOSErr(NewBaseAddrPtrError); { Bye-Bye !!! }
        end; { if }

        HLock(macBits);

        { NOTE that we 're filling in the BitMap/PixMap fields of the new Port }
        { directly , so we do NOT call _SetPortBits or _SetCPortPix later : }

        if gSystem.hasColorQD then begin

            itsColors := SetupPixMap(itsPixMap, macBits, offRowBytes, theBounds);
            if itsColors = nil then begin
                SetPort(savePort);
                FailOSErr(ColorTableError);
            end; { if }

            itsMaxDevice := CreateGDevice(itsPixMap);
            if itsMaxDevice = nil then begin
                SetPort(savePort);
                FailOSErr(CreateGDeviceError);
            end; { if }

        end { if }
        else begin
            { Black-and-white }

            macPort^.portBits.baseAddr := macBits^;    { macBits is a locked handle. }
            macPort^.portBits.rowBytes := offRowBytes;
            macPort^.portBits.bounds := theBounds;
        end; { else }

        SetPort(savePort);

        ForceNextPrepare;
    end; { IPixMap }


{****************************************************}
{}
{        Free                                                                                                                                                                                                                                }
{}
{        Destroy a PixMap object, resetting all pointers.                                                                                            }
{}
{****************************************************}

    procedure CPixMap.Free;

        var
            theColors: CTabHandle;

    begin { Free }
        if macPort <> nil then begin
            if gSystem.hasColorQD then begin

                if itsColors <> nil then begin
                    theColors := itsColors;
                    itsColors := nil;
                    DisposCTable(theColors);
                    theColors := nil;
                end; { if }

                CloseCPort(CGrafPtr(macPort));
                itsPixMap := nil;    { For completeness: itsPixMap pointed to the pixel map in macPort. }

                if itsMaxDevice <> nil then begin
                    ForgetHandle(itsMaxDevice^^.gdITable);
                    ForgetHandle(itsMaxDevice);
                    itsMaxDevice := nil;
                end; { if }

            end { if }
            else begin
                { Yucky B & W }
                ClosePort(macPort);
            end; { else }

            ForgetPtr(macPort);
            macPort := nil;    { So inherited method doesn't try to do this again, otherwise big-time bomb! }
        end; { if }

        if macBits <> nil then begin
            HUnlock(macBits);
            ForgetHandle(macBits);
            macBits := nil;
        end; { if }

        macBitMap.baseAddr := nil; { No need to repeat yourself !!}

        inherited Free;
    end; { Free }


{****************************************************}
{}
{        PixelIsBlack                                                                                                                                                                                                        }
{}
{        Determine whether the pixel at the specified coordinates is black.                                        }
{        Returns FALSE if the pixel is white or the point is not within the PixMap.                    }
{        This method is overriden SOLELY because I need to avoid all reference to                 }
{        "macBitMap" in order to NOT have to HLock the "itsPixMap".                                                        }
{}
{****************************************************}

    function CPixMap.PixelIsBlack (pixelPos: LongPt): Boolean;

        var
            hPos, vPos: Integer;
            bitNum: LongInt;
            bounds: LongRect;
            theBitMap: BitMapPtr;

    begin { PixelIsBlack }
        GetBounds(bounds);
        if (not PtInLongRect(pixelPos, bounds)) then begin
            PixelIsBlack := FALSE; { Point is not in pixel map. }
        end { if }
        else begin
            if gSystem.hasColorQD then begin
                { Okay to dereference, since nothing below moves memory. }
                theBitMap := BitMapPtr(itsPixMap^);
            end { if }
            else begin
                theBitMap := @thePort^.portBits;
            end; { else }

            hPos := pixelPos.h - theBitMap^.bounds.left;
            vPos := pixelPos.v - theBitMap^.bounds.top;

            { Point is within BitMap.  Convert point into }
            { a bit offset from the start of the image: }

            bitNum := Longint(vPos) * theBitMap^.rowBytes * 8 + hPos;
            PixelIsBlack := BitTst(theBitMap^.baseAddr, bitNum);

        end; { else }
    end; { PixelIsBlack }


{****************************************************}
{}
{        BeginDrawing                                                                                                                                                                                                    }
{}
{        Set up for drawing to a BitMap. If it doesn't have its own port,                                                }
{        make it the port bits of the current QuickDraw grafPort. Save the                                        }
{        current port bits so they can be restored later by the EndDrawing                                        }
{        method. If it has its own port, save the current port and SetPort                                            }
{        to the BitMap's port.}
{}
{****************************************************}

    procedure CPixMap.BeginDrawing;

    begin { BeginDrawing }
        if macPort = nil then begin
            if gSystem.hasColorQD then begin
                savePixMap := CGrafPtr(thePort)^.portPixMap;
                SetPortPix(itsPixMap);
            end { if }
            else begin
                saveBitMap := thePort^.portBits;
                SetPortBits(macPort^.portBits);    { Really!? Dereference nil? }
            end; { else }
        end { if }
        else begin
            GetPort(savePort);
            SetPort(macPort);
        end; { else }

        if gSystem.hasColorQD then begin
            saveDevice := GetGDevice;
            SetGDevice(itsMaxDevice);
        end; { if }
    end; { BeginDrawing }


{****************************************************}
{}
{        EndDrawing                                                                                                                                                                                                            }
{}
{        Reset the port to the way it was before the BeginDrawing message                                    }
{        was sent. If BitMap has its own port, restore the saved Grafport.                                        }
{        Otherwise, restore the saved bitmap in the current port.                                                                    }
{}
{****************************************************}

    procedure CPixMap.EndDrawing;

    begin { EndDrawing }
        if macPort = nil then begin
            if gSystem.hasColorQD then begin
                SetPortPix(savePixMap);
            end { if }
            else begin
                SetPortBits(saveBitMap);
            end; { else }
        end { if }
        else begin
            SetPort(savePort);
        end; { else }

        if gSystem.hasColorQD then begin
            SetGDevice(saveDevice);
        end; { if }
    end; { EndDrawing }


{****************************************************}
{}
{        CopyFrom                                                                                                                                                                                                                }
{}
{        Copy bits from a BitMap to the bit map of the current port. The                                                }
{        fromRect is a rectangle in this BitMap (source rect), and the                                                        }
{        toRect is a rectangle in the current port's bit map (dest rect).                                                    }
{        maskRgn is a clipping region specified in the same coords as the                                                }
{        dest rect, i.e., the coords of the current port. A nil maskRgn means                                    }
{        that no extra clipping is performed. Copying takes place using the                                        }
{        transfer mode stored in the xferMode instance variable.                                                                    }
{}
{****************************************************}

    procedure CPixMap.CopyFrom (fromRect, toRect: LongRect;
                                    maskRgn: RgnHandle);

        var
            saveForeColor, saveBackColor: RGBColor;
            kBlackColor, kWhiteColor: RGBColor;

    begin { CopyFrom }
        if gSystem.hasColorQD then begin
            GetForeColor(saveForeColor);
            GetBackColor(saveBackColor);

            with kBlackColor do begin
                red := $0000;
                green := $0000;
                blue := $0000;
            end; { with }
            with kWhiteColor do begin
                red := $FFFF;
                green := $FFFF;
                blue := $FFFF;
            end; { with }

            RGBForeColor(kBlackColor);
            RGBBackColor(kWhiteColor);
        end; { if }

        LCopyBits(macPort^.portBits, thePort^.portBits, fromRect, toRect, xferMode, maskRgn);

        if gSystem.hasColorQD then begin
            RGBForeColor(saveForeColor);
            RGBBackColor(saveBackColor);
        end; { if }
    end; { CopyFrom }


{****************************************************}
{}
{        CopyTo                                                                                                                                                                                                                        }
{}
{        Copy bits to a BitMap from the bit map of the current port. The                                                }
{        fromRect is a rectangle in the current port's bit map (source rect),                                    }
{        and the toRect is a rectangle in this BitMap (dest rect). maskRgn is                                    }
{        a clipping region specified in the same coords as the dest rect,                                                    }
{        i.e., the coords of this BitMap. A nil maskRgn means that no extra                                        }
{        clipping is performed. Copying takes place using the transfer mode                                        }
{        stored in the xferMode instance variable.                                                                                                                }
{}
{****************************************************}

    procedure CPixMap.CopyTo (fromRect, toRect: LongRect;
                                    maskRgn: RgnHandle);

        var
            kBlackColor, kWhiteColor: RGBColor;

    begin { CopyTo }
        BeginDrawing;

        if gSystem.hasColorQD then begin
            with kBlackColor do begin
                red := $0000;
                green := $0000;
                blue := $0000;
            end; { with }
            with kWhiteColor do begin
                red := $FFFF;
                green := $FFFF;
                blue := $FFFF;
            end; { with }

            RGBForeColor(kBlackColor);
            RGBBackColor(kWhiteColor);
        end; { if }

        LCopyBits(thePort^.portBits, macPort^.portBits, fromRect, toRect, xferMode, maskRgn);

        EndDrawing;
    end; { CopyTo }


{****************************************************}
{}
{        GetBounds                                                                                                                                                                                                                }
{}
{        Return the bounding rectangle of a PixMap. This rectangle defines                                        }
{        the size and coordinate system of the PixMap.                                                                                                    }
{}
{****************************************************}

    procedure CPixMap.GetBounds (var theBounds: LongRect);

        var
            itsBounds: Rect;

    begin { GetBounds }
        if gSystem.hasColorQD then begin
            itsBounds := itsPixMap^^.bounds;
        end { if }
        else begin
            itsBounds := macPort^.portBits.bounds;
        end; { else }
        QDToLongRect(itsBounds, theBounds);
    end; { GetBounds }


{****************************************************}
{}
{        SetBoundsOrigin                                                                                                                                                                                            }
{}
{        Set the coordinates of the top left corner of the bounds of a                                                            }
{        PixMap. This changes the coordinate system of the PixMap.                                                            }
{}
{****************************************************}

    procedure CPixMap.SetBoundsOrigin (hOrigin, vOrigin: Integer);

        var
            newLBounds: LongRect;
            newSBounds: Rect;

    begin { SetBoundsOrigin }
        if not (gSystem.hasColorQD & ((itsPixMap = nil) | (itsMaxDevice = nil))) then begin

            GetBounds(newLBounds);

            { The next four lines correspond to the inherited method. }
            newLBounds.right := newLBounds.right + hOrigin - newLBounds.left;
            newLBounds.bottom := newLBounds.bottom + vOrigin - newLBounds.top;
            newLBounds.left := hOrigin;
            newLBounds.top := vOrigin;

            LongToQDRect(newLBounds, newSBounds);

            RectRgn(gUtilRgn, newSBounds);        { Can't pass instance variable directly, }
            macPort^.visRgn := gUtilRgn;                { because RectRgn moves memory. }
            macPort^.portRect := newSBounds;
            macPort^.clipRgn := gUtilRgn;

            if gSystem.hasColorQD then begin
                itsPixMap^^.bounds := newSBounds;
                {  itsMaxDevice^^.gdPMap := itsPixMap; }
                itsMaxDevice^^.gdRect := newSBounds;
            end { if }
            else begin
                macPort^.portBits.bounds := newSBounds;
            end; { else }
        end; { if }
    end; { SetBoundsOrigin }


{****************************************************}
{}
{        SetupPixMap                                                                                                                                                                                                        }
{}
{        Set the location-specific and size-specific information of the pixel map.                        }
{        This is a private method.                                                                                                                                                                    }
{}
{****************************************************}

    function CPixMap.SetupPixMap (aPixMap: PixMapHandle;
                                    imageBits: Handle;
                                    bytesPerRow: Integer;
                                    theBounds: Rect): CTabHandle;

        var
            newColors: CTabHandle; { Color table used for the offscreen PixMap. }
            depth: Integer;
            savedAlloc: Boolean;
            error: OSErr;

    begin { SetupPixMap }
        ASSERT(aPixMap <> nil);

        newColors := nil;
        depth := aPixMap^^.pixelSize;

        { Clone the clut if indexed color; allocate a dummy clut if direct color. }
        savedAlloc := SetAllocation(kAllocCanFail);

        if depth <= 8 then begin
            newColors := aPixMap^^.pmTable;
            error := HandToHand(Handle(newColors));
        end { if }
        else begin
            newColors := CTabHandle(NewHandleClear(SizeOf(ColorTable) - SizeOf(CSpecArray)));
            error := MemError;
        end; { else }

        savedAlloc := SetAllocation(savedAlloc);

        if error <> noErr then begin
            SetupPixMap := nil;
        end { if }
        else begin
            { Initialize fields common to indexed and direct PixMaps. }

            aPixMap^^.baseAddr := imageBits^;    { This is a safe assignment; imageBits is locked. }
            aPixMap^^.rowBytes := BitOr(bytesPerRow, $8000);    { MSB set for PixMap. }
            aPixMap^^.bounds := theBounds;
            aPixMap^^.pmVersion := 0; { No special stuff. }
            aPixMap^^.packType := 0; { Default PICT pack. }
            aPixMap^^.packSize := 0; { Always zero in memory. }
            aPixMap^^.hRes := kDefaultRes; { 72 DPI default res. }
            aPixMap^^.vRes := kDefaultRes; { 72 DPI default res. }
            { aPixMap^^.pixelSize := depth;  -- Already done. }
            aPixMap^^.planeBytes := 0; { Not used. }
            aPixMap^^.pmReserved := 0; { Not used. }

            { Initialize the fields specific to indexed and direct PixMaps. }

            if depth <= 8 then begin
                aPixMap^^.pixelType := 0; { Indicates indexed. }
                aPixMap^^.cmpCount := 1; { Have 1 component. }
                aPixMap^^.cmpSize := depth; { Component size = depth. }
                aPixMap^^.pmTable := newColors; { Handle to CLUT. }
            end { if }
            else begin
                aPixMap^^.pixelType := RGBDirect; { Indicates direct. }
                aPixMap^^.cmpCount := 3; { Have 3 components. }
                if depth = 16 then begin
                    aPixMap^^.cmpSize := 5;     { 5 bits/component.     }
                end { if }
                else begin
                    aPixMap^^.cmpSize := 8;     { 8 bits/component. }
                end; { else }
                newColors^^.ctSeed := 3 * aPixMap^^.cmpSize;
                newColors^^.ctFlags := 0;
                newColors^^.ctSize := 0;
                aPixMap^^.pmTable := newColors;
            end; { else }

            SetupPixMap := newColors;
        end; { else }
    end; { SetupPixMap }


{****************************************************}
{}
{        CreateGDevice                                                                                                                                                                                                }
{}
{        Build and offscreen device for use with the offscreen pixmap.                                                    }
{        This is a private method.                                                                                                                                                                 }
{}
{****************************************************}

    function CPixMap.CreateGDevice (basePixMap: PixMapHandle): GDHandle;

        var
            newDevice: GDHandle; { Handle to the new GDevice.}
            embryoITab: ITabHandle; { Handle to the embryonic inverse table. }
            savedAlloc: Boolean;
            deviceRect: Rect;        { Rectangle of GDevice. }
            depth: Integer;

    begin { CreateGDevice }
        { Initialize a few things before we begin. }
        newDevice := nil;
        embryoITab := nil;

        { Allocate memory for the new GDevice. }
        savedAlloc := SetAllocation(kAllocCanFail);
        newDevice := GDHandle(NewHandleClear(SizeOf(GDevice)));
        savedAlloc := SetAllocation(savedAlloc);

        if newDevice <> nil then begin

            { Allocate the embryonic inverse table. }
            savedAlloc := SetAllocation(kAllocCanFail);
            embryoITab := ITabHandle(NewHandleClear(2));
            savedAlloc := SetAllocation(savedAlloc);

            if embryoITab = nil then begin
                ForgetHandle(newDevice);
                newDevice := nil;
            end
            else begin

                { Set rectangle of device to PixMap bounds. }
                deviceRect := basePixMap^^.bounds;

                depth := basePixMap^^.pixelSize;

                { Initialize the new GDevice fields. }
                newDevice^^.gdRefNum := 0; { Only used for screens. }
                newDevice^^.gdID := 0; {Won’t normally use. }
                if depth <= 8 then begin
                    newDevice^^.gdType := clutType; { Depth ≤ 8; clut device. }
                end { if }
                else begin
                    newDevice^^.gdType := directType; { Depth > 8; direct device. }
                end; { else }
                newDevice^^.gdITable := embryoITab;    { 2-byte handle for now. }
                newDevice^^.gdResPref := kITabRes; { Normal inv table res. }
                newDevice^^.gdSearchProc := nil; { No color-search proc. }
                newDevice^^.gdCompProc := nil; { No complement proc. }
                newDevice^^.gdFlags := 0;     { Will set these below. }
                newDevice^^.gdPMap := basePixMap;    { Reference our PixMap. }
                newDevice^^.gdRefCon := 0; { Won’t normally use. }
                newDevice^^.gdNextGD := nil;     { Not in GDevice list. }
                newDevice^^.gdRect := deviceRect;    { Use PixMap dimensions. }
                newDevice^^.gdMode := -1; { For non-screens. }
                newDevice^^.gdCCBytes := 0; { Only used for screens. }
                newDevice^^.gdCCDepth := 0; { Only used for screens. }
                newDevice^^.gdCCXData := nil; { Only used for screens. }
                newDevice^^.gdCCXMask := nil; { Only used for screens. }
                newDevice^^.gdReserved := 0;     { Currently unused. }

                { Set color-device bit if PixMap isn’t black & white. }
                if depth > 1 then begin
                    SetDeviceAttribute(newDevice, gdDevType, true);
                end; { if }

                { Set bit to indicate that the GDevice has no video driver. }
                SetDeviceAttribute(newDevice, noDriver, true);

                { Initialize the inverse table. }
                if depth <= 8 then begin
                    MakeITable(basePixMap^^.pmTable, newDevice^^.gdITable, newDevice^^.gdResPref);
                    if QDError <> noErr then begin
                        ForgetHandle(newDevice);
                        ForgetHandle(embryoITab);
                        newDevice := nil;
                    end; { if }
                end; { if }
            end; { else }
        end; { if }

        CreateGDevice := newDevice;
    end; { CreateGDevice }


end. { CPixMap }